perm filename PARSE[SAI,TES] blob
sn#049726 filedate 1973-06-18 generic text, type T, neo UTF8
00100 COMMENT ⊗ VALID 00022 PAGES
00200 RECORD PAGE DESCRIPTION
00300 00001 00001
00400 00003 00002 HISTORY
00500 00005 00003 Parser Description
00600 00010 00004 Parse Data
00700 00013 00005 Parser Routine -- Crank Up
00800 00016 00006 Compare Loop
00900 00018 00007 Pop to Temps, Do Execs
01000 00022 00008 Restore Stack, Scan
01100 00027 00009 Timer Package
01200 00031 00010
01300 00034 00011
01400 00036 00012 Debugging Package -- Description
01500 00041 00013 Variables
01600 00048 00014 Stplin -- Break on <crlf>
01700 00049 00015 Dmyexc, etc. -- Main Control Loops
01800 00052 00016 Dmy -- Inna, Inn --Display Subroutine
01900 00056 00017
02000 00057 00018 Read L/P
02100 00060 00019 Ddtg, Rego, Proxx -- Enter, Leave DDT, Proceed from Debug
02200 00062 00020 Prinlin -- Print Stack Entry Line
02300 00064 00021
02400 00068 00022 Decfil, Ascfil, Prinsym
02500 00072 ENDMK
02600 ⊗;
02700 COMMENT ⊗HISTORY
02800 AUTHOR,REASON
02900 021 202000000040 ⊗;
03000
03100
03200 COMMENT ⊗
03300 VERSION 16-2(32) 8-25-72 BY KVL TO MAKE CERTAIN PARSE TOKENS AVAILABLE GLOBALLY
03400 VERSION 16-2(31) 7-3-72 BY DCS MANY FIXES, INSTALL VERSION 16
03500 VERSION 15-2(18-30) 6-13-72 RANDOMNESS
03600 VERSION 15-2(17) 2-26-72 BY DCS ADD {PRO,EXC,SCN,LIN}CNT COUNTERS
03700 VERSION 15-2(10) 2-21-72 BY HJS THE BRAVE NEW PARSER WORLD
03800 VERSION 15-2(9) 2-10-72 BY DCS BUG #GR# DO MINOR THINGS TO FTDEBUGGER
03900 VERSION 15-2(8) 2-5-72 BY DCS BUG #GJ# ADD LSTON LISTING CONTROL STUFF
04000 VERSION 15-2(7) 2-1-72 BY DCS BUG #GH# 6M IS SCANNER BREAK, <ESC> I INTERRUPTS STATT CR
04100 VERSION 15-2(6) 2-1-72 BY DCS BUG #GG# Lnnnnn ≡ Lnnnnn/. in FTDEBUGger
04200 VERSION 15-2(5) 2-1-72 BY DCS LPSTOP FROM USER TABLE TO COMPILER
04300 VERSION 15-2(4) 12-26-71 BY DCS BUG #FU# REENABLE ACCESS TO FTDEBUGGER FROM ERR STUFF
04400 VERSION 15-2(3) 12-22-71 BY DCS BUG #FT# GET PRINSYM OUT OF FTDEBUG (MYERR CALLS)
04500 VERSION 15-2(2) 12-2-71 BY DCS INSTALL VERSION NUMBER
04600 ⊗;
00100 COMMENT ⊗Parser Description⊗
00200
00300 LSTON (PARSE)
00400 BIT2DATA (PARSE TOKEN CLASS/OPERATOR BITS)
00500 ↓CLSIDX←←11
00600
00700 ↓OPER←←0⊗=18 ;HIGH ORDER BIT FOR RESERVED WORD SYMBOL TABLE
00800 ↓CLASOP←←OPER+CLSIDX⊗=18 ;SAME, BUT FOR CLASS MEMBERS
00900 ENDDATA
01000
01100 BEGIN PARSE
01200 DSCR PARSE --- Sail's production interpreter.
01300 DES
01400 This is the production interpreter for the SAIL
01500 language. It is table driven, by tables organized
01600 as follows. Each production is represented by an entry:
01700
01800 1. (optional name in ascii -- if bit 35 is on,
01900 signal the debugging package)
02000 2. xwd [where to go if compare FAILS],[where if SUCCEEDS]
02100 3. --ID numbers, etc. stored in 12 bit bytes.
02200 4. address of production to "pushj" to (optional).
02300
02400
02500 The interpreter has 5 parts. The five operations are
02600 performed in series. The last four are executed
02700 only if the first one (the compares on the parse stack)
02800 succeeds. The parts are:
02900
03000 1. Compare the parse stack with the ID numbers stored
03100 in the 12 bit bytes. The types of compares and
03200 depth are determined by bits in the byte--
03300 The operations performed are:
03400
03500 <no bits> compare ID number against stack
03600 bclass Compare class of stack element to ID class
03700 bcare Careful compare -- ignore class information.
03800 bdone Done -- go on to part 2.
03900
04000 If the compares fail before reaching the "done"
04100 indication, the interpreter transfers its attention
04200 to the production named in the "FAIL" location.
04300
04400 2. Pop the parse stack elements which are involved in
04500 the current production.
04600 The top element is put in PARLEF, the
04700 next in PARLEF+1, etc. The generator stack
04800 entries are popped (in synchronism) into temporaries
04900 GENLEF, GENLEF+1, etc.
05000 3. Restore the stacks. The bytes are examined
05100 as above, starting where step 3 left off.
05200 The stacks are not actually restored at this time.
05300 Instead, the right half temporaries PARRIG and GENRIG
05400 are composed from information in the bytes:
05500
05600 btemp Restore the temporary pointed to by the
05700 12 bit byte.
05800 <no bits> Use the byte as immediate information for
05900 the parse stack.
06000 bdone Done -- go to step 4.
06100
06200 4. Call the necessary executive routine. The bytes
06300 are examined
06400
06500 <no bits> Executive routine. Use 12 bit byte as index
06600 into EXCTAB.
06700 bclass Executive routine appropriate to class.
06800 Pick up the parse stack temporary
06900 pointed to by the current 12 bit byte. Pick up next
07000 byte and subtract from first (this gives us
07100 a RELATIVE base). Then get the next 12 bit byte, and
07200 use it as index into EXCTAB for the routine
07300 to call.
07400 bdone Done -- go to step 5.
07500
07600
07700 5. Scan. The byte is the number of times to call the
07800 scanner.
07900 6. This last byte (the one which specified the number of scans)
08000 may also indicate a production pushj or popj.
08100
08200 bclass pushj to the location specified in the next
08300 full word in the production tables.
08400 bcare popj.
08500
08600
08700
08800
08900 The interpreter is called by:
09000
09100 PUSH P,[PRODGO]
09200 JRST PARSE
09300
09400
09500
09600
09700 ⊗;
09800
09900 DEFINE SUBR (X) <PUSHJ P,X>
00100 COMMENT ⊗Parse Data⊗
00200
00300 ;DECLARATIONS FOR ACCUMULATORS
00400
00500 ACDATA (PARSER)
00600 PP←←SP
00700 GP←←7
00800 PROD←←10
00900 PTR←←12
01000
01100
01200 ZERODATA (PARSER VARIABLES)
01300
01400 ↓FTCOUNT←←0
01500 IFN FTCOUNT <
01600 ↓CARCNT: 0 ;COUNT OF NUMBER OF CAREFUL COMPARES
01700 ↓CLSCNT: 0 ;COUNT OF NUMBER OF CLASS COMPARES
01800 ↓REGCNT: 0 ;COUNT OF NUMBER OF REGULAR COMPARES
01900 >;IFN FTCOUNT
02000
02100 ;SAVPAR, SAVPOP, SAVSEM, TEMCNT -- temporaries for the PARSER
02200 ↑SAVPAR: 0
02300 ↑SAVPOP: 0
02400 ↑SAVSEM: 0
02500 ↓TEMCNT: 0
02600
02700
02800 TABCONDATA (PARSER BIT TABLE)
02900
03000 ; BIT TABLE FOR CLASS OPERATIONS -- GAIN SPEED OVER CALCULATING THEM
03100 ↓BITAB:
03200 FOR I←0,=35 <
03300 1 ⊗ I >
03400
03500 DATA (PARSER PARSE TOKENS)
03600
03700 COMMENT ⊗
03800 These variables allow access to PARSE token numbers, for use by
03900 EXECS when they have to examine or change the PARSE stack -- for
04000 example, TRAGO must search the PARSE stack to generate code
04100 for leaving blocks, loops, etc.
04200 ⊗
04300 ↑%NSP: NSP
04400 ↑%NIP: NIP
04500 ↑%ASSDO: NASSDO & 777
04600 ↑%DOL: NDOL & 777
04700 ↑%NBEG: RBEGIN & 777
04800 ↑%PDNO: NPDNO & 777
04900 ↑%NFORC: NFORCA & 777
05000 ↑%NPDEC: NPDEC & 777
05100 ↑%OPC: NOPC & 777 ;OPCODE, SET BY SETSIZ (GENERATOR)
05200 ↑%WHILC: NWHILC & 777
05300 ↑%CTRU1: CLASOP+NCTRU1
05400 ↑%CFLS1: CLASOP+NCFLS1
05500 ↑%EOFILE: NEOFILE & 777
05600 ↑%BLKFRC: NBLKFRC & 777
05700 ↑%NBLAT: NBLAT & 777
05800 ↑%MPRO: NMPRO & 777
05900
06000 ↑%ILB: TILB & 777
06100 ↑%ISV: TISV & 777
06200 ↑%ARID: NARID & 777
06300 ↑%PCALL: NPCALL & 777
06400 ↑%FCALL: NFCALL & 777
06500 ↑%S: NS & 777
06600 ↑%ITV: TITV & 777
06700
06800 ENDDATA
06900
00100 COMMENT ⊗Parser Routine -- Crank Up⊗
00200
00300 ;DECLARATIONS OF CONTROL BITS IN PRODUCTION BYTES.
00400
00500 BITDATA (PARSER CONTROL)
00600 BCLASS←← 4000 ;CONTROL BITS IN 12 BIT BYTE.
00700 BTEMP ←← 2000
00800 BCARE ←← 2000 ;MUST BE SAME AS BTEMP
00900 BDONE ←← 1000 ;DONE WITH THIS "PHASE"
01000 BPRESUME ←← 400
01100
01200 ENDDATA
01300
01400 ↑PRODGO: BB0 ;PRODUCTION WITH WHICH TO START
01500 ↑PROCON: IF0 ; PRODUCTION TO START COND. ASSEMBLY
01600 WH0 ; PRODUCTION TO START WHILEC
01700 CS0 ; PRODUCTION TO START CASEC
01800 FR0 ; PRODUCTION TO START FORC
01900 FL0 ; PRODUCTION TO START FORLC
02000 DF0 ; PRODUCTION TO START DEFINE
02100
02200
02300 ↑PARSE: ;THIS IS THE PARSER !
02400 MOVE TEMP,PCSAV ; GET PRODUCTION CONTROL STACK POINTER
02500 ; *** DCS CHANGED 11-30-71
02600 PARSIT: SKIPGE PROD,(TEMP) ; GET PRODUCTION
02700 JRST (PROD) ; PRODUCTION IS CODE, NOT INTERPRETED
02800 ; CURRENTLY USED ONLY TO RETURN AFTER DONES
02900 ; *** DCS
03000 HRRZ PROD,(PROD) ;PICK UP SUCCESS POINTER
03100 IFN FTDEBUG <SETZM DEBTEM>
03200 SKIPA C,[XWD 0,-1] ;REGISTER FOR CLASS COMPARE TEST AND START
03300
03400 FAIL: HLRZ PROD,(PROD) ;GET FAILURE POINTER
03500
03600 PROGO: IFN FTDEBUG <
03700 ;;#GH# DCS 2-1-72 (3-5) USE INTERRUPTS FOR ASYNCH BREAKS
03800 AOS PROCNT ;COUNT NUMBER OF PRODUCTIONS LOOKED AT
03900 ↑PRODBK: JRST DUMPRO ;CHECK FOR PRODUCTION BREAK OR INTERRUPT
04000 >
04100 POOG: HRLZI PTR,(<POINT 12,0>) ;INITIALIZE BYTE POINTER
04200 HRRI PTR,1(PROD) ;MORE BYTE POINTER
04300 HRRZ PP,PPSAV ;MOVE PARSE STACK POINTER INTO PP FOR USE
00100 COMMENT ⊗ Compare Loop⊗
00200
00300 COMP: ILDB A,PTR ;PICK UP FIRST BYTE
00400 TRNE A,BCLASS!BCARE!BDONE ;REGULAR COMPARE?
00500 JRST NOREG ;NO
00600 IFN FTCOUNT, <AOS REGCNT>
00700 CAME A,(PP) ;COMPARE BYTE TO STACK
00800 JUMPN A,FAIL ;GO TO FAILURE PRODUCTION UNLESS "SIGMA"
00900 SOJA PP,COMP ;LOOP
01000
01100 NOREG: TRZE A,BCLASS ;CLASS COMPARE?
01200 JRST CLASSCOM ;YES
01300 TRZN A,BCARE ;CAREFUL COMPARE?
01400 JRST POPTEM ;DONE WITH COMPARES
01500
01600 CARE: HRRZ B,(PP) ;GET ONLY ID NUMBERS FROM STACK
01700 IFN FTCOUNT,<AOS CARCNT>
01800 CAIE B,(A) ;COMPARE TOKEN AGAINST BYTE
01900 JRST FAIL ;BAD COMPARE
02000 SOJA PP,COMP
02100
02200
02300 CLASSCOM:
02400 CAML C,(PP) ;LOOK TO SEE IF CLASS INDEX IS ON
02500 JRST FAIL ;NO -- STACK ENTRY WAS NOT CLASS MEMBER
02600 MOVEI CLSIDX,CLSTAB ;PREPARE THE INDEX REGISTER FOR TDNE@
02700 TRZE A,400 ;ON IF CLASS NUMBER GREATER THAN 36.
02800 MOVEI CLSIDX,CLSTAB+CLASSNO ;OTHER CLASS TABLE.
02900 MOVE B,BITAB-1(A) ;MAGIC BIT FOR THIS CLASS NUMBER.
03000 IFN FTCOUNT, < AOS CLSCNT >
03100 TDNE B,@(PP) ;SEE IF CLSTAB HAS THE BIT ON
03200 SOJA PP,COMP ;YES -- GO ON
03300 JRST FAIL ;NO
03400
00100 COMMENT ⊗ Pop to Temps, Do Execs⊗
00200
00300
00400 ;POP OFF TOP OF STACK INTO TEMPORARIES. THIS IS TO KEEP STACKS
00500 ;(GENERATOR AND PARSE) IN SYNC, AND KEEP EXEC ROUTINES FROM
00600 ;CLOBBERING THEM.
00700
00800 POPTEM: HRRZ C,PPSAV ;COMPUTE NUMBER OF THINGS TO POP.
00900 SUBI C,(PP) ;OK, READY TO GO.
01000 IFN FTDEBUG,<MOVEM C,DEBTEM>
01100 MOVE GP,GPSAV ;PICK UP STACK POINTERS
01200 MOVE PP,PPSAV
01300 SETZM B ;ZERO THE INITIAL COUNTER
01400 POPA: SOJL C,RESTA ;DONE POPPING ?
01500 POP GP,GENLEF(B) ;POP GENERATOR ENTRY
01600 POP PP,PARLEF(B)
01700 AOJA B,POPA ;NOT DONE YET
01800 RESTA: MOVEI B,-BDONE(A) ;TAKE ACCOUNT OF BIT.
01900 MOVEM B,TEMCNT ;COUNT OF RIGHT HALF TEMPORARIES.
02000 RESTB: ILDB A,PTR ;GET NEXT BYTE FROM TABLE
02100 JUMPE B,EXECA
02200 TRZE A,BTEMP ;RESTORE FROM TEMPORARY ?
02300 JRST RESTMP ;YES
02400 CAIGE A,CLASSNO ;RESTORE WITH CLASS INDEX?
02500 TLO A,CLSIDX ;YES
02600 MOVEM A,PARRIG-1(B) ;STORE IN RIGHT HALF TEMPORARY
02700 MOVE C,GENLEF-1(B) ;SEMANTICS ARE COPIED FOR SAKE OF
02800 MOVEM C,GENRIG-1(B) ;CONVENIENCE FOR T SG → E SG
02900 SOJA B,RESTB ;GO FOR MORE
03000
03100 RESTMP: MOVE C,PARLEF-1(A) ;GET THE TEMP. FROM THE LEFT STORAGE
03200 MOVEM C,PARRIG-1(B) ;AREA AND PUT IT IN THE RIGHT ONE.
03300 MOVE C,GENLEF-1(A)
03400 MOVEM C,GENRIG-1(B) ;
03500 SOJA B,RESTB ;LOOP UNTIL DONE.
03600
03700 ;CALL ANY EXECUTIVE ROUTINES THAT ARE NEEDED. THE TABLE
03800 ;EXCTAB, LISTING ALL ROUTINES, IS PUT TOGETHER BY THE
03900 ;PRODUCTION TABLE ASSEMBLER.
04000
04100 EXECA: MOVE TEMP,PCSAV ; GET PRODUCTION CONTROL STACK POINTER
04200 MOVEM PROD,(TEMP) ; SAVE PRODUCTION POINTER
04300 MOVEM PP,PPSAV ;SAVE PARSE STACK POINTER
04400 MOVEM GP,GPSAV ;AND GENERATOR STACK POINTER
04500
04600 EXECB: TRZE A,BDONE ;DONE ?
04700 JRST REST ; YES -- RESTORE STACKS.
04800 TRZE A,BCLASS ;CLASS TYPE ROUTINE?
04900 JRST EXCLS
05000 TRZE A,BCARE ;INDEX SPECIFIED DIRECTLY?
05100 JRST EXIND
05200 EXGO: PUSH P,PTR
05300 IFN FTDEBUG <
05400 AOS EXCCNT ;COUNT # EXECS SEEN
05500 ;; #GH# (3) CONT
05600 ↑EXCBK: SKIPE PTR,.DBG. ;ANY CHANCE OF BREAK?
05700 JRST DMYEXC ; YES, CALL THE DEBUG PACKAGE >
05800 EXDO: XCT EXCTAB-1(A) ;CALL THE ROUTINE WITH GENCLS IN B
05900 EXDON: POP P,PTR ;RESTORE THE WORLD
06000 ILDB A,PTR ;GET NEXT BYTE
06100 JRST EXECB ;TRY AGAIN
06200
06300 EXCLS: HRRZ B,PARLEF-1(A)
06400 ILDB A,PTR ;A NOW HAS AN INDEX UNTO THE CLASS
06500 SUB B,A ;B HAS THE RELATIVE INDEX
06600 ILDB A,PTR ;NOW INDEX TO ROUTINE
06700 JRST EXGO ;GO DO THE ROUTINE
06800 EXIND: MOVE B,A ;THE INDEX IS SPECIFIED EXPLICITLY
06900 ILDB A,PTR
07000 JRST EXGO ;GO DO IT
00100 COMMENT ⊗ Restore Stack, Scan⊗
00200
00300
00400 ;RESTORE THE STACKS FROM THE TEMPORARIES.
00500 ;CALL THE SCANNER THE RIGHT NUMBER OF TIMES, AND
00600 ;GO START ALL OVER AGAIN.
00700
00800 REST: MOVE GP,GPSAV
00900 MOVE PP,PPSAV
01000 SKIPN B,TEMCNT
01100 JRST SCANA
01200
01300 RES1: PUSH PP,PARRIG-1(B) ;RESTORE PARSE ITEM.
01400 PUSH GP,GENRIG-1(B) ;AND SEMANTIC ITEM.
01500 SOJN B,RES1 ;GO BACK FOR MORE.
01600
01700
01800
01900 SCAN1: MOVEM PP,PPSAV ;SAVE STACK POINTERS
02000 MOVEM GP,GPSAV ;SAVE STACK POINTERS
02100 SCANA: MOVE TEMP,PCSAV ;
02200 ADDI PTR,1 ; PTR POINTS TO PUSHJ ADDRESS
02300 PUSH TEMP,PTR ; ASSUME PUSHJ
02400 TRNE A,BCARE ; CHECK FOR A POPJ WHICH NEEDS TO RESTORE SCNNO.
02500 TRNE A,BPRESUME ; SCNNO AND DOESN'T INVOLVE A PARSER SWITCH
02600 JRST SCAN2 ; NO
02700 HLRE B,-2(TEMP) ; THIS IS THE CASE WHEN ONE HAS AN INTERRUPTED
02800 JUMPLE B,SCAN2 ; PRODUCTION (I.E. DEFINE) WHICH IS TO BE
02900 TRZ A,BCARE+BCLASS ; RESUMED. JUMPLE BECAUSE OF [-1,RELSE]
03000 ADD A,B ; AT BOTTOM OF STACK. RESTORE FLAGS. POPJ
03100 SUB TEMP,X22 ; PRIORITY OVER PUSHJ IF BOTH ARE SPECIFIED
03200 SCAN2: MOVEM A,SCNNO ; NUMBER OF SCANS TO DO
03300 MOVEM TEMP,PCSAV ; SAVE PRODUCTION CONTROL STACK POINTER
03400 DPUSH: TRNN A,777 ; ANY SCANS TO DO?
03500 JRST DOIT ; NO, GO DO PUSH, POP, OR NOTHING
03600 TRZE A,BPRESUME ; PARSER SWITCH?
03700 JRST[TRZE A,BCARE ; YES, POPJ?
03800 JRST[SUB TEMP,X22 ; YES, SET PCSAV STRAIGHT
03900 MOVEM TEMP,PCSAV ;
04000 MOVE TEMP,SCWSV ; POP SCNWRD STACK
04100 SUB TEMP,X11 ;
04200 MOVEM TEMP,SCWSV ;
04300 JRST DPSHED] ;
04400 DPSHED: SKIPE PRSCON ; DETERMINE WHICH PARSER ONE IS CURRENTLY IN AND
04500 SKIPA TEMP,[CGPSAV-1] ; GET THE ADDRESS TO SAVE ITS PARSER DESCRIPTOR.
04600 MOVEI TEMP,SGPSAV-1 ; SAVE SEMANTIC STACK POINTER, PARSE STACK
04700 PUSH TEMP,GPSAV ; POINTER, CONTROL STACK POINTER, AND A POINTER
04800 PUSH TEMP,PPSAV ; TO THE SCNWRD STACK.
04900 PUSH TEMP,PCSAV ;
05000 MOVE TBITS2,SCNWRD ; SAVE SCNWRD
05100 MOVE B,SCWSV ;
05200 MOVEM TBITS2,(B) ;
05300 PUSH TEMP,SCWSV ;
05400 SKIPE PRSCON ; DETERMINE WHICH PARSER IS TO BE RESUMED AND GET
05500 SKIPA TEMP,[XWD -1,SSCWSV] ; THE ADDRESS OF ITS PARSER DESCRIPTOR.
05600 HRROI TEMP,CSCWSV ;
05700 POP TEMP,SCWSV ; RESTORE SCNWRD AND SCNWRD STACK POINTER
05800 MOVE B,SCWSV ;
05900 MOVE TBITS2,(B) ;
06000 MOVEM TBITS2,SCNWRD ;
06100 POP TEMP,PCSAV ; RESTORE CONTROL STACK POINTER
06200 MOVE B,PCSAV ;
06300 HLRZ B,(B) ;
06400 MOVEM B,SCNNO ; RESTORE NUMBER TO SCAN
06500 POP TEMP,SP ; RESTORE PARSE STACK POINTER. MUST BE IN AC AS
06600 MOVEM SP,PPSAV ; WELL AS IN MEMORY.
06700 POP TEMP,GPSAV ; RESTORE SEMANTIC STACK POINTER
06800 SETCMM PRSCON ; SET PARSER IN CONTROL
06900 JRST .+1]
07000 PUSHJ P,SCANNER ; GO SCAN
07100 ;;#GH# (3-5) END
07200 IFN FTDEBUG, <
07300 AOS SCNCNT ; COUNT CALLS ON SCANNER
07400 SKIPGE PTR,.DBG. ; PERHAPS WANT TO BREAK?
07500 PUSHJ P,DUMSCN ; YES, GO HANDLE
07600 >;IF FTDEBUG
07700 ;;#GH# (3-5)
07800 SOS A,SCNNO ; DECREMENT SCAN COUNT
07900 JRST DPUSH ; AND LOOP
08000 DOIT: TRNE A,BCLASS ; IF PUSHJ, THEN
08100 JRST PARSE ; ALL DONE
08200 MOVE TEMP,PCSAV ; RESTORE PRODUCTION CONTROL STACK POINTER
08300 SUB TEMP,X11 ; PUSHJ ASSUMPTION WAS WRONG
08400 TRNE A,BCARE ; POPJ?
08500 SUB TEMP,X11 ; YES, POP PRODUCTION CONTROL STACK
08600 MOVEM TEMP,PCSAV ; SAVE PRODUCTION CONTROL STACK POINTER
08700 JRST PARSIT ; CONTINUE
00100 COMMENT ⊗Timer Package⊗
00200
00300 IFN TIMER, <
00400 BEGIN TIMER
00500 COMMENT ⊗
00600 THIS IS A LITTLE TIMER THAT WORKS FOR SAIL.
00700 IF YOU START THE THING AT "TIMIT", THE COMPILER WILL
00800 BE INTERPRETED. COUNTS OF THE GENERAL TYPE OF INSTRUCTION
00900 (IN INTAB) AND WHERE (IN THE BUCKETS DEFINED BY THE MACRO
01000 RR AT THE END) ARE KEPT. USING THIS ROUTINE SLOWS COMPILATION
01100 DOWN BY A FACTOR OF ROUGHLY 25.
01200
01300 ⊗
01400 EXTERNAL JOBSA
01500
01600
01700
01800 ;AC'S
01900
02000 ZZ ← 0 ;CRUCIAL IN NUMBERS.
02100 AA ← 1 ; DITTO.
02200
02300 ↑TIMIT: ;START HERE
02400 SETZM INTAB
02500 MOVE ZZ,[XWD INTAB,INTAB+1]
02600 BLT ZZ,INTAB+7
02700 MOVEI ZZ,BKLEN ;NUMBER OF BUCKETS IN TABLE.
02800 MOVEI AA,BKBEG ;FIRST BUCKET.
02900 BKLOP: SETZM 1(AA) ;COUNT OF INSTRUCTIONS IN BUCKET.
03000 ADDI AA,2
03100 SOJG ZZ,BKLOP ;LOOP......
03200
03300 HRRZ AA,JOBSA ;WHERE TO START !!
03400 MOVEM AA,PPCNT
03500 MOVEM AA,PEECEE ;MY PROGRAM COUNTER
03600
03700 SEARCH: MOVEM 3,SAV3
03800 MOVEM ZZ,ZZSAV ;GET SOME AC'S
03900 MOVEM 4,SAV4
04000
04100 MOVEI ZZ,BKLEN
04200 MOVEI 3,BKBEG ;PREPARE TO SEARCH BLOCK.
04300 COMLUP: HLRZ 4,(3) ;LOWER BOUND
04400 CAIGE AA,(4) ;ABOVE IT
04500 JRST NOFAIL
04600 HRRZ 4,(3)
04700 CAILE AA,(4) ;AND UNDER IT.
04800 JRST NOFAIL
04900 HRRZM 4,CURTOP
05000 HLRZ 4,(3)
05100 HRRZM 4,CURBOT
05200 MOVEI 3,1(3) ;PLACE WHERE COUNT IS
05300 MOVEM 3,CURPNT
05400
05500 ALLON: MOVE 3,SAV3
05600 MOVE 4,SAV4
05700 MOVE ZZ,ZZSAV
05800 JRST STARUP ;GO GO GO
05900
06000 NOFAIL: ADDI 3,2
06100 SOJG ZZ,COMLUP ;LOOK SOME MORE
06200 JRST ALLON ;IF YOU CAN'T FIND A NEW BUCKET, USE
06300 ;OLD ONE.
06400
06500 DOIT: MOVE AA,AASAV
06600 INST: XCT @PPCNT ;MOST INSTR'S EXECUTED HERE.
06700 JRST NEXT ;DID NOT SKIP
06800 AOS PEECEE
06900 NEXT: MOVEM AA,AASAV
07000 RECORD: SETZM XCTF ;EXECUTE GOING ?
07100 MOVE AA,PEECEE ;PC ← MA
07200 MOVEM AA,PPCNT
07300 RECGO: CAML AA,CURBOT ;SEE IF EFFECTIVE ADDRESS IN THIS
07400 CAMLE AA,CURTOP ;BUCKET ...
07500 JRST SEARCH ;NOT IN THIS BUNCH.
07600 STARUP: CAMN AA,PROGS ;BREAK POINT
07700 TIMBRK: JFCL ;PLACE TO PLANT A REAL DDT BREAKPOINT
07800 AOS @CURPNT ;INDEX THE BUCKET COUNTER
07900 LDB AA,[POINT 3,@PPCNT,2] ;INSTRUCTION
08000 SKIPN XCTF
08100 AOS PEECEE ;PC ← PC +1
08200 AOS INTAB(AA) ;RECORD INSTRUCTION FREQUENCY
08300 JRST @DISTAB(AA)
00100
00200 INTAB: BLOCK 10
00300 DISTAB: UUOINST ;DISPATCH TABLE
00400 DOIT
00500 SPECL
00600 JUMPS
00700 DOIT
00800 DOIT
00900 DOIT
01000 DOIT
01100
01200
01300 UUOINST:
01400 LDB AA,[POINT 9,@PPCNT,8]
01500 CAIE AA,41 ;INIT ?
01600 JRST DOIT
01700 ERR <INIT'S ARE NOT USED IN SAIL>
01800
01900 JUMPS: LDB AA,[POINT 6,@PPCNT,5] ;INTERPRET JUMPS
02000 CAIN AA,32
02100 JRST JUMPXX
02200 CAIE AA,34
02300 CAIN AA,36
02400 SKIPA
02500 JRST DOIT
02600 JUMPXX: MOVE AA,@PPCNT
02700 TLZ AA,37
02800 HLLM AA,JMPINS ;SAVE IT.
02900 MOVE AA,AASAV
03000 JMPINS: JRST TRA ;GO TO TRA IF IT TAKES.
03100 JRST NEXT ;DID NOT TAKE.
03200 TRA: MOVEM AA,AASAV
03300 MOVEM ZZ,ZZSAV
03400 TRAIT:
03500 MOVE ZZ,@PPCNT
03600 MOVEI ZZ,@ZZ ;DEPENDS ON ZZ BEINO ZERO.
03700 MOVEM ZZ,PEECEE ;NEW VALUE
03800 MOVE AA,ZZ
03900 MOVE ZZ,ZZSAV
04000 JRST RECORDIT
04100
04200 SPECL: LDB AA,[POINT 9,@PPCNT,8]
04300 TRCE AA,30
04400 TRNN AA,40
04500 JRST DOIT
04600 TRCN AA,30
04700 JRST DOIT
04800 TRNN AA,10
04900 JRST DPUSHJ ;OP CODES 260 - 267
05000 CAIE AA,256 ;XCT
05100 JRST [CAILE AA,251
05200 JRST JUMPXX
05300 JRST DOIT]
05400 SETOM XCTF ;START EXECUTE CYCLE
05500 MOVEM ZZ,ZZSAV
05600 MOVE ZZ,@PPCNT
05700 MOVE AA,AASAV
05800 MOVEI ZZ,@ZZ ;EFFECTIVE ADDRESS....
05900 MOVEM ZZ,PPCNT
06000 MOVE AA,ZZ
06100 MOVE ZZ,ZZSAV
06200 JRST RECGO
06300
06400
06500 DPUSHJ: MOVEM ZZ,ZZSAV
06600 ANDI AA,7
06700 JRST @.+1(AA)
06800
06900 PUSHJ1
07000 DOIT
07100 DOIT
07200 POPJ1
07300 JSR1
07400 JSP1
07500 JSA1
07600 JRA1
07700
07800 PUSHJ1: MOVE ZZ,PEECEE
07900 LDB AA,[POINT 4,@PPCNT,12]
08000 DPB AA,[POINT 4,.+3,12]
08100 EXCH ZZ,ZZSAV
08200 MOVE AA,AASAV
08300 PUSH ZZSAV
08400 JRST TRA
08500
08600 POPJ1: LDB AA,[POINT 4,@PPCNT,12]
08700 DPB AA,[POINT 4,.+2,12]
08800 MOVE AA,AASAV
08900 POP PEECEE
09000 MOVEM AA,AASAV
09100 HRRZS AA,PEECEE
09200 JRST RECORDIT
09300
09400 JSR1: MOVE ZZ,@PPCNT
09500 MOVE AA,AASAV
09600 MOVEI ZZ,@ZZ
09700 MOVE AA,PEECEE
09800 MOVEM AA,@ZZ
09900 AOS AA,ZZ
10000 MOVEM AA,PEECEE
10100 MOVE ZZ,ZZSAV
10200 JRST RECORDIT
10300
10400 JSP1: LDB AA,[POINT 4,@PPCNT,12]
10500 MOVE ZZ,PEECEE
10600 MOVEM ZZ,ZZSAV(AA) ;RECORD IN BOTH PLACES.
10700 MOVEM ZZ,(AA)
10800 JRST TRAIT
10900
11000 JSA1: JRA1:
11100 ERR <NOT IMPLEMENTED>
11200 PPCNT: 0
11300 CURTOP: 0
11400 CURBOT: 0
11500 ZZSAV: 0
11600 AASAV: 0
11700 BLOCK 20
11800 SAV3: 0
11900 SAV4: 0
12000 XCTF: 0
12100 PEECEE: 0
12200 CURPNT: 0
12300 PROGS: 0
12400
12500
12600
12700
12800 BKLEN ←=12
12900 BKBEG:
13000 DEFINE RR (BEGINNING,ENDD) < XWD BEGINNING,ENDD
13100 0
13200 >
13300
13400 RR LARGER,PRODGO ;COMMAND SCANNER & INITIALIZATION
13500 RR PARSE,<POPTEM-1>;PRODUCTION SEARCHER
13600 RR POPTEM,TIMIT-1 ;STACK POPPER & EXEC ROUTINE CALLER
13700 RR BKBEG,<SCAN-1> ;DEBUGGING ROUTINES
13800 RR SCAN,<ENTER-1> ;SCANNER ...
13900 RR ENTER,<GENINI-1>;SYMBOL TABLE LOOKUP & ENTER
14000 RR GENINI,<LEPINI-1>;HIGH LEVEL ARITHMETIC GENERATORS
14100 RR LEPINI,<CONV-1>;HIGH LEVEL LEAP GENERATORS
14200 RR CONV,RINGSORT-1 ;LOW LEVEL GENERATORS
14300 RR RINGSORT,PATCH ;CORE MANAGEMENT, STRING GARBAGE COLLECTOR
14400 RR 400000,777777 ;CORE MANAGEMENT, STRING GARBAGE COLLECTOR
14500 BLOCK =2
14600
14700
14800
14900
15000
15100
15200 BEND
15300 >
15400 >;TEMPORARY END OF IFN FTDEBUG
15500 SUBTTL Debug package.
00100 COMMENT ⊗Debugging Package -- Description
00200
00300 Here begins the debugging package.
00400 These routines provide parse/semantic information at selected points
00500 during a compilation. This display can be obtained when:
00600 1. A production is about to be tried
00700 2. An Exec routine is about to be called
00800 3. A token has just been scanned
00900 4. A selected line has been reached (or on every line)
01000 5. <esc>I is typed (Stanford only) -- after next Token scan
01100
01200 Information displayed is:
01300 1. The current file, page, and line number.
01400 2. The current input line, with a line-feed inserted to indicate
01500 the position of the Scanner.
01600 3. The current macro being expanded, if any, same format.
01700 4. The reason for the break.
01800 5. The top few elements of the parse/semantics stacks, including:
01900 a) @ if the token is a member of some class
02000 b) The symbolic name of the token in the parse stack (e.g., TLPRN)
02100 c) The address of any Semblk associated with that token.
02200 d) Two Fields, the TBITS word from that Semblk, in octal.
02300 e) The left-half SBITS word in octal.
02400 f) The ACNO field, in octal.
02500 g) A few characters from the name (string value) of the entity, if any.
02600
02700 The break routine then prints "#" and waits for directives, which may be:
02800
02900 B Breakpoint operation. Must be followed by "s" (set) or "r"
03000 (remove) then the production name, followed by a space.
03100 xxM Set Mode. Must be preceded by a number xx :
03200 1. Break only when execs are about to be called.
03300 2. Break only on <esc>I or line break or production breakpoint.
03400 3. Break on all productions and execs.
03500 4. Break as specified in current breakpoint mode, but don't pause
03600 for directives -- terminated by <esc>I break or line break
03700 5 Continuously display the line being scanned (Stanford III only)
03800 6 Break after each call on SCANNER (no automatic stack display).
03900 C Count the free storage cells.
04000 nnP Proceed. If nn is present, no actual breaks will occur until nn
04100 opportunities to do so (of any kind, excluding <esc>I) have
04200 presented themselves. PROCNT, EXCCNT, SCNCNT, LINCNT are counts of
04300 the number of productions, execs, etc., seen so far.
04400 D Go to DDT or RAID -- operates by setting a breakpoint if using RAID,
04500 return with <ctrl>P. In DDT, return by REGO$G. Returns to debug
04600 loop, types "#", awaits command.
04700 L Stop on selected line -- followed by line/page, compiler will stop
04800 just after reading specified line, but before processing it. If /page
04900 is omitted, current one is implied. Other commands may follow this
05000 one on the line, but a <crlf> is required to activate the commands.
05100 If the file has no SOS line numbers, use the ordinality of the line
05200 in the current page.
05300 xxS Show the xx'th stack entry (0 is top) in the above format.
05400 T Terminate and return to error handler (if you came from there).
05500
05600 This whole section of code is merely a convenience, and not really part of
05700 the guts of the compiler. Most of the routines were written to satisfy
05800 real debugging needs as the compiler was being developed.
05900 ⊗
00100 COMMENT ⊗ Variables⊗
00200
00300 ZERODATA (PARSE DEBUGGER VARIABLES)
00400
00500 COMMENT ⊗
00600 PRODUCTION/EXEC BREAK CONTROL VARIABLES
00700
00800 .DBG. -- This value is set by the /M switch in the command line,
00900 or by the M parameter in the Debugging Scanner. Its values,
01000 corresponding "M" codes, and functions are ---
01100 0 -- /2M -- Do not break on anything but "asynchronous break"
01200 (user types CR to break in)
01300 >0 -- /3M -- Break when EXEC routine to be executed
01400 <0 -- /1M -- Break when any production matches, or on EXEC
01500 /5M and /6M cut .DBG. out of the loop.
01600 ⊗
01700 ↑↑.DBG.: 0
01800
01900 ;;#GH# DCS 2-1-72 (4-5) ADD 6M SCANNER BREAK, INTERRUPT FOR ASYNCH BREAKS
02000 ↓SCNBRK: 0 ;TEMP USED IN DMY TO INDICATE SCANNER BREAK
02100
02200 ↑↑SCBCNT: 0 ;USED IN DMY AS REPEAT COUNT FOR ANY BREAK
02300 ↑↑PROCNT: 0 ;NUMBER OF TIMES THROUGH THE PRODUCTION DEBUGGER (DPY OR NOT)
02400 ↑↑EXCCNT: 0 ;NUMBER OF TIMES THROUGH THE EXEC DEBUGGER
02500 ↑↑SCNCNT: 0 ;NUMBER OF TIMES THROUGH THE SCAN BREAK ROUTINE
02600 ↑↑LINCNT: 0 ;NUMBER OF LINE BREAKS
02700
02800 ;BREAKP -- set if DMY is being executed because of a production
02900 ; breakpoint -- see DSCR for debug routines for more details
03000 ↓BREAKP: 0
03100
03200 ;EXC -- set before DMY is called -- 0 if PRODUCTION Break,
03300 ; -1 if EXEC break (unless SCNBRK set, then irrelevant)
03400 ↓EXC: 0
03500
03600 ;MULTP -- set if user is not to be given control after input
03700 ; line, stack, etc. are displayed (subject to INTERRUPT, of
03800 ; course (/4M mode)
03900 ↑↑MULTP: 0
04000
04100 ;PLINSW -- set if input line is to be displayed at every possible
04200 ; moment (/5M mode)
04300 ↑↑PLINSW: 0
04400
04500 COMMENT ⊗
04600 OTHER DEBUGGER VARIABLES, RICH AND POOR
04700
04800 IFN FTDEBUG < ;JUST CONDIT THE BIG ONES
04900 ACSAV -- block for saving ACs when doing DMY
05000 ⊗
05100 ↓ACSAV: BLOCK 20
05200 >
05300
05400 ;; #GH# (4) REMOVE ASYNTMP
05500 ↓ASAV: 0 ;SAVE AC A SOMETIMES
05600
05700 COMMENT ⊗
05800 BKR -- specifies break character for ASCFIL routine -- see for
05900 details (used to allow ASCII strings to be considered as
06000 single entities at one time, for shipping around, later
06100 as groups of characters, to be interspersed with other data
06200 e.g., setting up title lines, printing display line, etc.
06300 ⊗
06400 ↑↑BKR: 0
06500
06600
06700 ↓CHAR: 0 ;TEMP FOR DEBUGGER SCANNER
06800
06900 IFN FTDEBUG <
07000 COMMENT ⊗
07100 DDFBUF, DDFPDL, DDRES
07200 Variables for implementing the DDFIND routine -- called from
07300 RAID or DDT to find the Semantics currently corresponding
07400 to a name.
07500 ⊗
07600 ↓DDFBUF: BLOCK 6 ;FOR INPUT OF ID
07700 ↓DDFPDL: BLOCK 11 ;SPECIAL PDP
07800 ↑↑DDRES: 0 ;RESULT IF FOUND
07900 ;DDFPDP -- SEE ALSO, BELOW
08000 >
08100
08200 ↓DEBTEM: 0 ;A TEMP
08300
08400 COMMENT ⊗
08500 EXROUTIN -- A call to the desired EXEC is placed here before
08600 going into the debugging business -- at an appropriate
08700 point, after the stack has been displayed, and the user
08800 has had a chance to respond (he can look at EXROUTIN, among
08900 other things), this is XCTed -- not used if not debugging
09000 ⊗
09100 ↑↑EXROUTIN: 0
09200
09300 ;FILBP -- PNEXTC transferred here when macro expansion is entered.
09400 ; Used to print arrow on input line display (see ASCFIL)
09500 ↑↑FILBP: 0 ;CONSIDER PUTTING THIS ELSEWHERE
09600
09700 ↓HIRAN: 0 ;RANDOM TEMP
09800
09900 ↓LSTPSW: 0 ;FLAG INDICATING LINE # BREAK TO DMY
10000
10100 ↓NEG: 0 ;RANDOM FLAG FOR NUMBER INPUTTER IN DEBUG SCANNER
10200
10300 ↓SENC: 0 ;RANDOM TEMP
10400
10500 ↓SETB: 0 ;RANDOM TEMP
10600
10700 ↓STLINE: 0 ;LINE # (ASCII) ON WHICH TO CAUSE LINE BREAK
10800 ↑↑STPAGE: 0 ;PAGE # (BINARY) ON WHICH TO CAUSE LINE BREAK
10900
11000 DATA (PARSE DEBUGGER VARIABLES)
11100
11200 IFN FTDEBUG <
11300 COMMENT ⊗
11400 HEADINGS FOR DEBUG OUTPUT (DESCRIBES REASON FOR BREAK, ETC.)
11500 ⊗
11600
11700 ;; #GH# (4) USED TO BE ASYNBUF
11800 ↑↑SCNBUF: ASCIZ "SCANNER BREAK
11900 "
12000
12100 ↑↑HBUF: ASCIZ "PRODUCTION IS "
12200
12300 ↑↑HDBUF: ASCIZ "LINE BREAK
12400 "
12500
12600 ↑↑XBUF: ASCIZ "EXEC ROUTINE "
12700
12800
12900 ↓DDFPDP: IOWD 10,DDFPDL ;PDP FOR DDFPDL (SEE DDRES)
13000
13100 ;OBUF -- Output buffer for TTYUUO'S to type stack info
13200 OBUF: ASCII/ /
13300 BLOCK 10
13400
13500 ;;#GR# DCS 2-8-72 (2-3) MINOR FTDEBUG FIXES
13600 ↑PRSBP: 0 ;-1 IF BP SET AT BRKHER (FOR D COMMAND)
13700 ;;#GR# (2)
13800
13900 >
14000 ENDDATA
00100 COMMENT ⊗ Stplin -- Break on <crlf>⊗
00200
00300 IFN FTDEBUG, < ;RESUME CONDITIONAL ASSEMBLY
00400 ↑STPLIN:PUSH P,A
00500 SETOM LSTPSW ;DO NOT PRINT HEADER FOR STACK
00600 MOVE A,STPAGE ;WANTS TO STOP ON THIS PAGE NUM
00700 JUMPE A,STPTHS ;EACH PAGE?
00800 CAME A,FPAGNO ;HAS IT COME BY YET?
00900 JRST LSTPJ ; (THERE WILL BE FILE REDUNDANCY)
01000 MOVE A,STLINE ;RIGHT PAGE, IS IT THE
01100 CAME A,ASCLIN ; DESIRED LINE?
01200 JRST LSTPJ ;NO
01300 STPTHS: SOSLE SCBCNT ;STOP YET?
01400 JRST LSTPJ ;NOPE
01500 SETZM EXC ;CLEAR USELESS PARAMS
01600 SETZM DEBTEM
01700 PUSHJ P,DMY
01800 LSTPJ: SETZM LSTPSW ;RESET
01900 POP P,A
02000 POPJ P,
00100 COMMENT ⊗ Dmyexc, etc. -- Main Control Loops⊗
00200
00300 EXTERNAL JOBDDT
00400 ;; #GH# (4) .DBG.= -1,,-1 OR 0,,-1 FOR EXEC BREAK,
00500 ;; #GH# -1,,-1 FOR PRODUCTION BREAK,
00600 ;; #GH# 400000,,-1 FOR SCANNER BREAK,
00700 ;; #GH# 400000,,377777 FOR <ESC>I BREAK
00800
00900 DMYEXC:JUMPGE PTR,DOXC ;ALWAYS BREAK IF GTR. 0 (NOT SCAN OR ASYN BREAK)
01000 TLNN PTR,200000 ;SCAN BREK?
01100 JRST EXDO ;YES, IGNORE .DBG. COMPLETELY
01200 DOXC: SOSLE SCBCNT ;SHOW IT YET?
01300 JRST EXDO ;NO
01400 PUSH P,EXCTAB-1(A) ;THE EXEC ROUTINE
01500 POP P,EXROUTIN
01600 SETOM EXC
01700 MOVEM A,ASAV
01800 PUSHJ P,DMY
01900 XCT EXROUTIN ;DO IT IF NECESSARY.
02000 JRST EXDON
02100
02200
02300 DUMPRO: MOVE A,-1(PROD) ;PICK UP PRODUCTION NAME
02400 SETZM BREAKP
02500 SETZM EXC
02600 MOVEM A,ASAV
02700 SKIPL PTR,.DBG. ;A STANDARD BREAK?
02800 JRST CHKBKP ; NO, CHECK PRODUCTION BREAKPOINT
02900 TLNN PTR,200000 ;PERHAPS A SCANNER BREAK?
03000 JRST POOG ; YES, IGNORE
03100 JRST YESPRO ;GO DISPLAY
03200 CHKBKP: TRNN A,1 ;A BREAKPOINT ?
03300 JRST POOG ;NO
03400 SETOM BREAKP ;YES
03500 YESPRO: SOSLE SCBCNT ;TIME TO QUIT?
03600 JRST POOG ;NO, AND AFTER ALL THAT, TOO!
03700 PUSHJ P,DMY
03800 JRST POOG
03900
04000 DUMSCN:
04100 NOEXPO <
04200 TRNE PTR,400000 ;WAS IT AN <ESC>I INTERRUPT?
04300 JRST NOINTR ; NO
04400 SETZM .DBG. ; YES, DON'T LET IT HAPPEN AGAIN
04500 SETZM MULTP
04600 JRST INTR
04700 >;NOEXPO
04800 NOINTR: TLNN PTR,200000 ;IS IT A SCAN BREAK?
04900 SOSLE SCBCNT ;AND HAVE WE DONE ENOUGH OF THEM?
05000 POPJ P, ; NO, PRODUCTION OR KEEP UP -- NEXT TIME
05100
05200 INTR: SETOM SCNBRK
05300 PUSHJ P,DMY
05400 SETZM SCNBRK
05500 POPJ P, ;DO IT
00100 COMMENT ⊗ Dmy -- Inna, Inn --Display Subroutine⊗
00200
00300 DMY: MOVEM 0,ACSAV
00400 MOVE 0,[XWD 1,ACSAV+1]
00500 BLT 0,ACSAV+16 ;SAVE ALL ACCUMULATORS
00600
00700
00800 ; DISPLAY A PRINT LINE IF RUNNING A DISPLAY
00900
01000 PUSHJ P,DSPLIN ;DISPLAY IF POSSIBLE
01100 JFCL ;IT DOESN'T MUCH MATTER ANYWAY
01200
01300 SETZM CHAR ;CHARACTER COUNTER
01400 MOVEI A,HDBUF
01500 SKIPE LSTPSW ;LINE NUMBER BREAK?
01600 JRST PRTHED ;YES, PRINT SIMPLE HEADING
01700 ;; #GH# (4)
01800 MOVEI A,SCNBUF
01900 SKIPE SCNBRK
02000 JRST PRTHED
02100 ;;#GH# (4-5) END
02200 MOVE PTR,[POINT 7,HBUF+3]
02300 SKIPE EXC ;CALLED FROM EXECUTIVE HANDLER?
02400 HRRI PTR,XBUF+3 ;YES
02500 MOVE A,ASAV ;GET SIXBIT OR → TO IT BACK
02600 SKIPE EXC
02700 MOVE A,EXCNAM(A) ;GET EX NAME
02800
02900 PUSHJ P,PRNSM ;PRINT THE SYMBOL
03000 PUSHJ P,CRLF
03100 MOVEI A,HBUF
03200 SKIPE EXC
03300 MOVEI A,XBUF
03400 PRTHED: CALL A,[SIXBIT/DDTOUT/]
03500 SKIPE SCNBRK ;DON'T VOLUNTEER STACK ON SCANNER
03600 JRST GO.ON ; BREAK
03700 MOVEI A,0
03800 MOVE B,DEBTEM
00100 ADDM B,GPSAV
00200 ADDM B,PPSAV
00300 P6: PUSH P,A
00400 PUSH P,B
00500 SETZM CHAR
00600 PUSHJ P,PRINLIN
00700 POP P,B
00800 POP P,A
00900 SOS A
01000 SOJE B,P6A
01100 SKIPE EXC
01200 JRST .+4
01300 CAME A,[-3]
01400 JRST P6
01500 JRST P6A
01600 MOVN C,A
01700 CAME C,DEBTEM
01800 JRST P6
01900
02000
02100 P6A: MOVN B,DEBTEM
02200 ADDM B,PPSAV
02300 ADDM B,GPSAV
02400 GO.ON: SKIPN LSTPSW ;STOP ON LINE BREAK ALWAYS
02500 SKIPN MULTP ;IN MULTIPLE PROCEED?
02600 JRST INNA ;NO
02700 SKIPN BREAKP
02800 JRST PRO ;PROCEED IF NO BREAKPOINT.
02900 ;;#GR# DCS 2-8-72 (3-3) MINOR FTDEBUG MODS
03000 ↑↑INNA: SETZB C,NEG
03100 INSKIP A ;ANY CHARS WAITING?
03200 OUTCHR ["#"] ;NO, TYPE WAITING MESSAGE
03300 INN: TTCALL A ;GET A CHAR FROM USER
03400 CAIN A,"P"
03500 JRST PROXX ;PROCEED
03600 CAIN A,"D" ;GO TO DDT
03700 JRST DDTG
03800 CAIN A,"B" ;BREAKPOINT
03900 JRST BP1
04000 CAIN A,"T"
04100 POPJ P, ;RETURN TO ERROR HANDLER
04200 CAIN A,"S" ;STACK EXAMINE.
04300 JRST STA
04400 CAIN A,"M" ;MODE
04500 JRST MOD1
04600 CAIN A,"C" ;COUNT
04700 JRST SCNT
04800 CAIN A,"L" ;PAGE AND LINE BREAK SPECS?
04900 JRST LINSTOP ; YES
05000 NOEXPO <
05100 CAIN A,"Q" ;SET A BREAKPOINT?
05200 JRST SETONE ; YES
05300 CAIN A,"R" ;REMOVE A BREAKPOINT?
05400 JRST REMONE ; YES
05500 >;NOEXPO
05600 CAIE A,"-"
05700 JRST [CAIG A,"9"
05800 CAIGE A,"0"
05900 JRST INN
06000 IMULI C,=10
06100 ADDI C,-"0"(A)
06200 JRST INN]
06300 SETOM NEG
06400 JRST INN
06500 STA:
06600 SKIPL NEG
06700 MOVNS C ;WE WERE TOLD TO COMPLEMENT IT
06800 MOVE A,C
06900 ADD A,DEBTEM ;TO GET INREASONABLE RANGE.
07000 PUSHJ P,PRINLIN
07100 JRST INNA
07200
07300 BP1: TTCALL A
07400 CAIN A,"S" ;SET?
07500 SETOM SETB
07600 CAIN A,"R"
07700 SETZM SETB
07800 SETZB B,SENC
07900 MOVE C,[POINT 6,B]
08000 BPX: TTCALL A
08100 SUBI A,40 ;CONVERT TO SIXBIT
08200 SKIPN SENC
08300 JUMPE A,BPX
08400 IDPB A,C
08500 SETOM SENC
08600 JUMPN A,BPX
08700 MOVEM B,HIRAN
08800
08900 MOVEI A,BB0-1 ;START HERE
09000 FLOP: CAIN A,IPROC ;END HERE
09100 JRST NOFND
09200 MOVE C,(A)
09300 TRZ C,1 ;TRUN OFF DEBUG BIT.
09400 CAMN C,B
09500 JRST YESFND
09600 AOJA A,FLOP
00100 COMMENT ⊗ Read L/P⊗
00200
00300 LINSTOP: ;GET LINE/PAGE NUMBERS
00400 TTCALL 14,0 ;WAIT FOR ACTIVATOR
00500 SETZM STLINE
00600 ;;#GG# DCS 2-1-72 (1-2) ASSUME CURRENT PAGE
00700 MOVEW STPAGE,FPAGNO ;ASSUME CURRENT PAGE
00800 ;;#GG#
00900 MOVE TEMP,[POINT 7,STLINE]
01000 MOVEI B,5 ;MAX USABLE COUNT
01100 LSLP10: TTCALL A ;GET A CHAR
01200 CAIL A,"0"
01300 CAILE A,"9" ;IS IT A DIGIT?
01400 JRST LSLP10 ;NO
01500 SKIPA ;YES
01600 LSLP1: TTCALL A ;GET A CHAR
01700 CAIL A,"0"
01800 CAILE A,"9" ;DIGIT?
01900 JRST LSLP2 ;NO, DONE
02000 SOJL B,LSLP1 ;FORGET AFTER 5
02100 IDPB A,TEMP ;PUT IT AWAY
02200 JRST LSLP1 ;LOOP
02300 LSLP2: MOVE B,STLINE ;GET RESULT
02400 LSLP3: TRNE B,376 ;LOW ORDER 0?
02500 AOJA B,LSLP4 ;NO, ALL OK
02600 LSH B,-7
02700 TLO B,"0"⊗(=18-7) ;YES, PUT IN ZEROES
02800 JRST LSLP3 ;LOOP UNTIL ALL ASCII CHARS
02900 LSLP4: MOVEM B,STLINE ;RESTORE IT
03000 CAIE A,"/" ;PAGE # SPECIFIED?
03100 JRST INNA ;NO
03200 MOVEI B,0 ;YES, GET PAGE #
03300 LSLP6: TTCALL A ;GET A CHAR
03400 CAIL A,"0"
03500 CAILE A,"9" ;DIGIT?
03600 JRST LSLP5 ; YES, DONE
03700 IMULI B,=10
03800 ADDI B,-"0"(A) ;COLLECT NUMBER
03900 JRST LSLP6 ;LOOP
04000 LSLP5: MOVEM B,STPAGE
04100 JRST INNA ;DONE
04200 ;;#GG# DCS 2-1-72 (2-2)
04300 CCPP: SKIPGE TEMP,STPAGE ;USE PAGE 1 IF NO PAGE YET
04400 MOVEI TEMP,1
04500 MOVEM TEMP,STPAGE
04600 ;;#GG#
04700
04800 NOFND: TERPRI <NOT FOUND>
04900 JRST INNA
05000
05100 YESFND: SKIPE SETB
05200 TRO C,1
05300 MOVEM C,(A) ;PUT IT BACK.
05400 JRST INNA
05500
05600 MOD1:
05700 JUMPL C,INNA
05800 CAIG C,6
05900 ;DCS 9-21-71
06000 PUSHJ P,STMD ;(SEE COMMAND SCANNER)
06100 JRST INNA
06200
06300
06400 NOEXPO <
06500 SETONE: SKIPE EXC ;IF CALLED FROM EXEC HANDLER,
06600 PUSHJ P,SETBKP ; SET A BREAKPOINT
06700 JRST INNA ;NEXT COMMAND
06800
06900 REMONE: SKIPE EXC
07000 PUSHJ P,REMBKP ;REMOVE IF FOUND
07100 JRST INNA ;FORGET IT IF NOT
07200 >;NOEXPO
07300
07400
07500
07600 SCNT: SETZM C
07700 SKIPA LPSA,BLFREE
07800 SLOPP: RIGHT ,%TBUCK,ALDD
07900 AOJA C,SLOPP
08000 ALDD: OCTPNT C
08100 JRST INNA
00100 ;Ddtg, Rego, Proxx -- Enter, Leave DDT, Proceed from Debug
00200 ;; #GR# (3)
00300
00400 DDTG: SKIPN A,JOBDDT
00500 JRST INNA ;NO DDT
00600 TLNE A,40 ;RAID VERSION 1?
00700 JRST PRODD ; YES, CAUSE A BREAKPOINT
00800 EXCH A,(P) ;NEW ADDRESS.
00900 HRRZM A,REGO ;WHERE TO CONTINUE
01000 JRST PRO ;CONTINUE
01100
01200 PROXX: TTCALL 11, ;CLEAR INPUT BUFFER BEFORE PROCEEDING
01300 MOVEM C,SCBCNT ;REPEAT FACTOR FOR SCANNER BREAK
01400 PRO: MOVE 0,[XWD ACSAV+1,1]
01500 BLT 0,16
01600 MOVE 0,ACSAV
01700 POPJ P, ;DONE
01800 ↑↑REGO: JRST .
01900
02000
02100 PRODD: MOVE A,-6(A) ;ADR OF $I
02200 MOVEM A,PRSBP ;STORE OUT OF ACS
02300 MOVE 0,[XWD ACSAV+1,1];GET 'EM BACK TEMPORARILY
02400 BLT 0,16
02500 MOVE 0,ACSAV
02600 ↑↑BRKHER:JSR @PRSBP ;BREAK HERE
02700 JRST INNA ;AWAY WE GO
02800
02900 ;;#GR# (3)
00100 COMMENT ⊗ Prinlin -- Print Stack Entry Line⊗
00200
00300 ;ROUTINE TO PUT TOGETHER A LINE ABOUT THE STACK ENTRY
00400 ;WHOSE INDEX IS IN REGISTER "A"
00500
00600 PRINLIN:MOVEM A,ASAV
00700 MOVE B,PPSAV
00800 ADDI B,(A)
00900 MOVE B,(B) ;STACK ENTRY
01000 MOVEI C,"@"
01100 CAIG B,400000
01200 MOVEI C," "
01300 DPB C,[POINT 7,OBUF,27] ;CLASS TYPE?
01400 MOVE A,SYMNAM (B) ;PRINT NAME
01500 MOVE PTR,[POINT 7,OBUF+1]
01600 PUSHJ P,PRNSM
01700 MOVE PTR,[POINT 7,OBUF+2,27]
01800 MOVE B,GPSAV
01900 ADD B,ASAV
02000 MOVE A,(B)
02100 PUSH P,A ;GENERATOR ENTRY
02200 PUSHJ P,NUM
02300 PUSHJ P,SPOUT
02400 MOVE D,(P) ;IS THERE AN ENTRY?
02500 CAMGE D,LPSTOP
02600 CAMGE D,LPSBOT
02700
02800 PING: JRST CRLF0
02900 HLRZ A,$TBITS(D)
03000 PUSHJ P,NUM
03100 PUSHJ P,SPOUT
03200 HRRZ A,$TBITS(D) ;TBITS
03300 PUSHJ P,NUM
03400 PUSHJ P,SPOUT
03500 HLRZ A,$SBITS(D)
03600 PUSHJ P,NUM
03700 PUSHJ P,SPOUT
03800 HRRZ A,$ACNO(D)
03900 PUSHJ P,NUM
04000 PUSHJ P,SPOUT
04100 HRRZ A,$PNAME(D) ;COUNT
04200 JUMPE A,CRLF0 ;NO PRINT NAME
04300 CAILE A,15
04400 MOVEI A,15
04500 HLRZ TEMP,$PNAME+1(D)
04600 CAIE TEMP,(<POINT 7,0>)
04700 JRST CRLF0
04800 MOVE D,$PNAME+1(D)
04900 SRFF: ILDB TEMP,D
05000 IDPB TEMP,PTR
05100 SOJG A,SRFF
05200
05300
05400
05500 CRLF0: POP P,A
05600 TRZ C,177
05700 IDPB C,PTR
05800 TTCALL 3,OBUF ;PRINT THE LINE
05900 TERPRI ;TERMINATE IT
06000 POPJ P,
06100
06200 CRLF: MOVEI C,15
06300 IDPB C,PTR
06400 MOVEI C,12
06500 IDPB C,PTR
06600 TRZ C,177
06700 IDPB C,PTR
06800 POPJ P,
06900
07000 SPOUT: MOVEI TEMP," "
07100 IDPB TEMP,PTR
07200 POPJ P,
07300 Comment ⊗ DDFIND -- find symbol for USER.
07400 Called from DDT or RAID by typing DDFIND$G ⊗
07500
07600 ↑DDFIND: EXCH P,DDFPDP ;IN CASE RAID IS DISHONEST
07700 PUSHJ P,SAVE ;IN GOGOL.IOSER
07800 SETZM DDFBUF
07900 MOVE TEMP,[XWD DDFBUF,DDFBUF+1] ;CLEAR BUFFER
08000 BLT TEMP,DDFBUF+5
08100 MOVEI A,0 ;COLLECT COUNT
08200 PUSH P,PNAME
08300 PUSH P,PNAME+1
08400 MOVE B,[POINT 7,DDFBUF]
08500 MOVEM B,PNAME+1 ;FIRST BYTE OF PNAME
08600
08700 DDF1: TTCALL TEMP ;GET A CHARACTER
08800 CAIN TEMP,15 ;TERMINATES
08900 JRST DDFDUN
09000 IDPB TEMP,B ;YES
09100 AOJA A,DDF1 ;GET IT ALL
09200 DDFDUN: HRRZM A,PNAME ;COUNT
09300 PUSH P,HPNT
09400 PUSH P,NEWSYM
09500 MOVE LPSA,SYMTAB
09600 PUSHJ P,SHASH
09700 SKIPE A,NEWSYM
09800 TERPRI <FOUND IT -- RESULTS IN DDRES>
09900 SKIPN A
10000 TERPRI <NOT FOUND>
10100 MOVEM A,DDRES
10200 POP P,NEWSYM
10300 POP P,HPNT
10400 POP P,PNAME+1
10500 POP P,PNAME
10600 MOVEI LPSA,0
10700 MOVEI TEMP,.+3
10800 MOVEM TEMP,UUO1(USER)
10900 JRST RESTR
11000 EXCH P,DDFPDP
11100 POPJ P, ;SINCE HE CALLED IT WITH PUSHJ P,
11200
11300
11400
11500 NUM: MOVNI C,6
11600 ROT A,=18
11700 PEP2: SETZM B
11800 ROTC A,3
11900 ADDI B,"0"
12000 IDPB B,PTR
12100 AOS CHAR
12200 AOJN C,PEP2
12300 POPJ P,
12400
12500
12600 SIXBT: MOVNI C,3
12700 P3: SETZM B
12800 ROTC A,6
12900 ADDI B,40
13000 IDPB B,PTR
13100 AOS CHAR
13200 AOJN C,P3
13300 POPJ P,
13400
13500 NOEXPO <
13600 EXTERNAL JOBDDT
13700 ↑SETBKP:
13800 PUSH P,A
13900 HRRZ TEMP,EXROUTINE ;→ADDR TO BE BREAKPOINTED
14000 SKIPE A,JOBDDT ;IS DDT LOADED?
14100 JSR TEMP,@-1(A) ; YES, SET THE BREAKPOINT
14200 ; THERE IS A DISPATCH TO A BREAKPOINT-SETTING ROUTINE HERE IN RAID ONLY
14300 APOPJ: POP P,A
14400 POPJ P,
14500
14600 ↑REMBKP:
14700 PUSH P,A
14800 HRRZ TEMP,EXROUTINE
14900 SKIPE A,JOBDDT ;DDT (RAID) LOADED?
15000 JSR TEMP,@-2(A) ; YES, REMOVE BREAKPOINT
15100 JRST APOPJ
15200 >;NOEXPO
15300 ↑PRNSM: PUSHJ P,PRINSYM ;PRINT THE SYMBOL
15400 MOVEI B," " ;FINISH OUT WITH SPACES
15500 JUMPGE C,PRSP1
15600 LLX: IDPB B,PTR
15700 AOS CHAR
15800 AOJN C,LLX
15900 POPJ P,
16000 > ;end of IFN FTDEBUG conditional assmby.
00100 COMMENT ⊗Decfil, Ascfil, Prinsym⊗
00200
00300 DSCR DECFIL
00400 CAL PUSHJ from text-line creators
00500 PAR D is number to be converted to ASCII
00600 TEMP is ASCII bp to output
00700 RES ASCII for D (with sign, if neg) is deposited via TEMP
00800 SID D, D+1 destroyed, TEMP updated
00900 ⊗
01000 ↑DECFIL: ; PUT A POSITIVE NUMBER IN ASCII IN BUFFER
01100 ; POINTED TO BY TEMP
01200
01300 JUMPGE D,POSFIL ;MIGHT BE NEGATIVE
01400 MOVEI D+1,"-"
01500 IDPB D+1,TEMP
01600 MOVMS D ;ISN'T NOW
01700
01800 POSFIL: IDIVI D,=10
01900 HRLM D+1,(P) ;IT'S RECURSIVE PRINTER TIME AGAIN
02000 SKIPE D
02100 PUSHJ P,POSFIL
02200 HLRZ D,(P)
02300 IORI D,"0"
02400 IDPB D,TEMP
02500 POPJ P,
02600
02700 DSCR ASCFIL
02800 CAL PUSHJ from routines which create text lines
02900 PAR A is input BP
03000 BKR is break char
03100 TEMP is output BP
03200 FILBP (in compiler) is bp to a char which is to be indicated
03300 by an arrow. (via DPY instrs if NOEXPO, LF otherwise).
03400 RES Text is moved from A's area to TEMP's, stopping when
03500 an input char = BKR (or if BKR<0, when char terminates line).
03600 If A ever = FILBP, stuff is done to produce the arrow or line
03700 feed (assumes that when this happens, output is going to DPY).
03800 SID B is destroyed, A and TEMP are updated.
03900 ⊗
04000 ↑ASCFIL:CAME A,FILBP
04100 JRST NOARROW ;NOT YET (OR NOT AGAIN)
04200 NOEXPO <
04300 SKIPL DPYSW ;ARE WE ON A DPY?
04400 JRST [
04500 >;NOEXPO
04600 MOVEI B,12
04700 IDPB B,TEMP ;NO, USE LINE FEED TO
04800 NOEXPO <
04900 JRST NOARROW] ; MARK PLACE IN LINE
05000 MOVE B,[DPYSTO STODPY] ;STORE THEM
05100 MOVEM B,1(TEMP)
05200 MOVE B,[<BYTE (7) 12,136 >+ 1]
05300 MOVEM B,2(TEMP)
05400 MOVE B,[DPYRST STODPY] ;RESTORE OLD POSITION
05500 MOVEM B,3(TEMP)
05600 ADDI TEMP,3
05700 TLZ TEMP,770000 ;POINT TO FIRST IN NEXT
05800
05900 >;NOEXPO
06000 NOARROW:
06100 ILDB B,A
06200 SKIPGE BKR
06300 JRST [JUMPE B,YPOPJ ;IN THIS MODE, WANT TO
06400 CAIE B,177 ;STOP ON 0, 12, OR 177
06500 CAIN B,12
06600 POPJ P,
06700 JRST FDIPB]
06800 CAMN B,BKR ;DONE?
06900 YPOPJ: POPJ P,
07000 FDIPB: IDPB B,TEMP ;NO -- STORE THIS ONE
07100 JRST ASCFIL
07200
07300 ; SIXBIT INPUT IN A
07400 ; USES B,C
07500 ; OUTPUT TO PTR'S BYTE POINTER
07600 ; MODIFIES CHAR
07700 ↑↑PRINSYM:
07800 MOVNI C,6 ;COUNT
07900 PRSP1: SETZM B
08000 ROTC A,6
08100 JUMPE B,PRSP2
08200 ADDI B,40 ;CONVERT TO ASCII
08300 IDPB B,PTR
08400 AOS CHAR
08500 AOJN C,PRSP1
08600 PRSP2: POPJ P,
08700 XALL
08800 SUBTTL Production Tables.
08900